COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(declare (fixsw t))
C00011 ENDMK
C⊗;
(declare (fixsw t))

(defun xreverse (current)
       (prog (next previous)
	     b     
	     (cond ((null current)(return previous)))
	     (setq next (cdr current))
	     (rplacd current previous)
	     (cond ((null next)(return current)))
	     (setq previous (cdr next))
	     (rplacd next current)
	     (cond ((null previous)(return next)))
	     (setq current (cdr previous))
	     (rplacd previous next)
	     (go b)))

(defun greverse (current)
       (let (x y)
	    (cond ((or (null current)
		       (null 
			(setq x 
			      (cdr current))))
		   current)
		  ((null 
		    (setq y 
			  (cdr x)))
		   (rplaca current
			   (prog1 (car x)
				  (rplaca x
					  (car current))))
		   current)
		  ((null 
		    (cdr y))
		   (rplaca current
			   (prog1 (car y)
				  (rplaca y
					  (car current))))
		    current)
		  (t (prog (next previous first second)
			   (setq first current second x)
			   (setq previous y next x)
			   (setq current (cdr previous))
			   b     
			   (rplacd previous next)
			   (setq next (cdr current))
			   (cond ((null next)
				  (rplaca first
					  (prog1 (car current)
						 (rplaca current
							 (car first))))
				  (rplacd first previous)
				  (rplacd second current)
				  (return first)))
			   (rplacd current previous)
			   (setq previous (cdr next))
			   (cond ((null previous)
				  (rplaca first
					  (prog1 (car next)
						 (rplaca next
							 (car first))))
				  (rplacd first current)
				  (rplacd second next)
				  (return first)))
			   (rplacd next current)
			   (setq current (cdr previous))
			   (cond ((null current) 
				  (rplaca first
					  (prog1 (car previous)
						 (rplaca previous
							 (car first))))
				  (rplacd first next)
				  (rplacd second previous)
				  (return first)))
			   (go b))))))


(defun kreverse (current)
       (prog (next previous)
	     (cond ((null current)(return ())))
	     b     
	     (setq next (cdr current))
	     (rplacd current previous)
	     (cond ((null next)(return current)))
	     (setq previous (cdr next))
	     (rplacd next current)
	     (cond ((null previous)(return next)))
	     (setq current (cdr previous))
	     (rplacd previous next)
	     (cond ((null current)(return previous)))
	     (go b)))

(DEFUN FASTER-GOOD-NREVERSE (LIST)
   (COND ((OR (NULL LIST) (NULL (CDR LIST))) LIST)
	 ((OR (NULL (CDDR LIST)) (NULL (CDDDR LIST)))
	     (LET ((REMEM (CAR (LAST LIST))))
		  (RPLACA (LAST LIST) (CAR LIST))
		  (RPLACA LIST REMEM) ) )
	 (T (PROG (TRAILER POINTER LEADER)
		  (SETQ TRAILER (CDR LIST)
			POINTER (CDR TRAILER)
			LEADER (CDR POINTER) )
	      RPT (RPLACD POINTER TRAILER)
		  (COND ((CDR LEADER) (SETQ TRAILER POINTER
					    POINTER LEADER
					    LEADER (CDR LEADER) )
				      (GO RPT) ))
		  (RPLACD (CDR LIST) LEADER)
		  (RPLACD LIST POINTER)
		  (SETQ TRAILER (CAR LEADER))
		  (RPLACA LEADER (CAR LIST))
		  (RETURN (RPLACA LIST TRAILER)) ) ) ) )

(include "timer.lsp[tim,lsp]")

(defun ghack (n m)
       (do ((n n (1- n))
	    (a ()))
	   ((= n 0))
	   (do ((m m (1- m)))
	       ((= m 0))
	       (setq a (greverse a)))
	   (push n a)))

(defun xhack (n m)
       (do ((n n (1- n))
	    (a ()))
	   ((= n 0))
	   (do ((m m (1- m)))
	       ((= m 0))
	       (setq a (xreverse a)))
	   (push n a)))

(defun khack (n m)
       (do ((n n (1- n))
	    (a ()))
	   ((= n 0))
	   (do ((m m (1- m)))
	       ((= m 0))
	       (setq a (kreverse a)))
	   (push n a)))

(defun lhack (n m)
       (do ((n n (1- n))
	    (a ()))
	   ((= n 0))
	   (do ((m m (1- m)))
	       ((= m 0))
	       (setq a (faster-good-nreverse a)))
	   (push n a)))

(defun ghack1 (n m)
       (do ((n n (1- n))
	    (a '(0 1 2 3))) 
	   ((= n 0))
	   (do ((m m (1- m)))
	       ((= m 0))
	       (setq a (greverse a)))
	   (push n a)))

(defun xhack1 (n m)
       (do ((n n (1- n))
	    (a '(0 1 2 3))) 
	   ((= n 0))
	   (do ((m m (1- m)))
	       ((= m 0))
	       (setq a (xreverse a)))
	   (push n a)))

(defun nhack (n m)
       (do ((n n (1- n))
	    (a ()))
	   ((= n 0))
	   (do ((m m (1- m)))
	       ((= m 0))
	       (setq a (nreverse a)))
	   (push n a)))

(timer gtimits
       (ghack 20. 5000.))

(timer xtimits
       (xhack 20. 5000.))

(timer ntimits
       (nhack 20. 5000.))

(timer ktimits
       (khack 20. 5000.))

(timer ltimits
       (lhack 20. 5000.))

(timer gtimitss
       (ghack 7. 10000.))

(timer xtimitss
       (xhack 7. 10000.))

(timer ntimitss
       (nhack 7. 10000.))

(timer ktimitss
       (khack 7. 10000.))

(timer ltimitss
       (lhack 7. 10000.))

(timer gtimitl
       (ghack 500. 100.))

(timer xtimitl
       (xhack 500. 100.))
       
(timer ntimitl
       (nhack 500. 100.))
       
(timer ktimitl
       (khack 500. 100.))
       
(timer ltimitl
       (lhack 500. 100.))
       
(timer xtimitl1
       (xhack1 500. 100.))
       
(timer gtimitl1
       (ghack1 500. 100.))
       
(timer gtimitsss
       (ghack 3. 50000.))

(timer xtimitsss
       (xhack 3. 50000.))

(timer ntimitsss
       (nhack 3. 50000.))

(timer ktimitsss
       (khack 3. 50000.))

(timer ltimitsss
       (lhack 3. 50000.))